www.gusucode.com > 星梦奇缘交友网 1 > 星梦奇缘交友网 1.0源码程序/love/leaveword/compact.asp

    <!-- #include file="config.asp" -->
<!-- #include file="style.asp" -->
<!-- #include file="admin_verify.asp" -->



<%
sub fsosupported()
dim tfso
on error resume next
err.number=0
set tfso=Server.CreateObject("Scripting.FileSystemObject")
set tfso=nothing
if err.number<>0 then
	response.write "服务器不支持FSO(File System Object),操作无法继续!<a href=""index.asp"">返回</a><script language=""JavaScript"">alert('服务器不支持FSO(File System Object),操作无法继续!');history.back();</script>"
	response.end
end if
on error goto 0
end sub

Call fsosupported
Response.Expires=-1
Dim fso, Engine
r_dbfile=server.mappath(dbfile)
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If fso.FileExists(r_dbfile & ".tmp") Then fso.DeleteFile (r_dbfile & ".tmp")


If fso.FileExists(r_dbfile) Then
	set ofile=fso.GetFile(r_dbfile)
	oldsize=ofile.size
	set ofile=nothing
	
	Set Engine = Server.CreateObject("JRO.JetEngine")
	if dbtype=1 then	'Access97
		Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & r_dbfile,"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & r_dbfile & ".tmp;Jet OLEDB:Engine Type=4"
	elseif dbtype=2 then	'Access2000
		Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & r_dbfile,"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & r_dbfile & ".tmp;"
	end if
	fso.CopyFile r_dbfile & ".tmp",r_dbfile
	fso.DeleteFile (r_dbfile & ".tmp")
	
	set ofile=fso.GetFile(r_dbfile)
	newsize=ofile.size
	set ofile=nothing	
	
End If
Set fso = nothing
Set Engine = nothing%>

数据库压缩完成!<a href="index.asp">返回</a>
<script language="javascript">alert('数据库压缩完成!\n\n压缩前大小:<%=oldsize%>字节\n压缩后大小:<%=newsize%>字节\n压缩率:<%=formatpercent((oldsize-newsize)/oldsize,2,true)%>');</script>
<html><meta http-equiv=refresh content=0;url=admin.asp></html>